home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
0B.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
21KB
|
929 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
#include "hdr.h"
#include "vars.h"
#include "dbxp.h"
#include "errmsgp.h"
#include "dclmapp.h"
#include "miscp.h"
#include "smiscp.h"
#include "chapp.h"
#include <ctype.h>
/* ctype.h needed for isupper, tolower, etc in 4.2 bsd*/
void adasem(Node node) /*;adasem*/
{
/* This is the driver routine for all semantic processing. It is called
* by the parser whenever the syntax tree for a compilation unit has
* been built. The input to this routine is an AST node, on which two
* maps are defined : AST, and SPANS. These maps are global to the front
* end.
*/
Node n1, n2, n3, n4;
char *id, *op_id;
Fortup ft1;
Tuple tup;
Node decl_node, id_node, l;
Symbol package, s1;
if (cdebug2 > 2) {
/* TO_ERRFILE("node type ");*/
#ifdef IBM_PC
printf("node type: %s %d %p\n", kind_str(N_KIND(node)), N_KIND(node),
node);
#else
printf("node type: %s %d %ld\n", kind_str(N_KIND(node)), N_KIND(node),
node);
#endif
}
/* The current node is placed in a global variable, from which the error
* routines can extract its span.
*/
current_node = node;
#ifdef DEBUG
if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
#endif
switch(N_KIND(node)) {
/* Chapter 2. Lexical elements*/
/* pragma -> [as_pragma identifier argument_list]*/
case(as_pragma):
process_pragma(node);
break;
/* argument_association -> [as_arg identifier expression]*/
case(as_arg):
break; /*Unpacked in process_pragmas.*/
/* Chapter 3. Declarations and types */
/* object_declaration -> [as_obj_decl identifier_list subtype_indic
* opt_expression]
*/
case(as_obj_decl):
obj_decl(node);
break;
/* const_declaration -> ['const_decl' identifier_list subtype_indic
* opt_expression]
*/
case(as_const_decl):
const_decl(node);
break;
/* num_declaration -> ['num_decl' identifier_list expression]*/
case(as_num_decl):
number_decl(node);
break;
/* type_decl -> ['type_decl' identifier discriminant_list
* type_definition]
*/
case(as_type_decl):
type_decl(node);
break;
/* Subtype_decl -> ['subtype_decl' identifier subtype_indic]*/
case(as_subtype_decl):
subtype_decl(node);
break;
/* subtype_indication -> ['subtype_indic', name opt_constraint]*/
case(as_subtype_indic):
/*[name, opt_constraint] := N_AST(node);*/
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* derived_type_definition -> ['derived_type' subtype_indication]*/
case(as_derived_type):
break;
/* discrete_range -> ['range' expression expression]*/
case(as_range):
/*[expression1, expression2] := N_AST(node);*/
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* range_attribute -> ['range_attribute' name range]*/
case(as_range_attribute):
N_KIND(node) = as_attribute;
n2 = N_AST3(node);
find_old(node);
adasem(n2);
break;
/* discrete_range -> ['range_expression' expression]*/
case(as_range_expression):
adasem(N_AST1(node));
break;
/* constraint -> ['constraint' general_aggregate]*/
case(as_constraint):
sem_list(node);
break;
/* enumeration_type -> [as_enum enumeration_literal_list]*/
case(as_enum):
sem_list(node);
break;
case(as_int_type):
break;
case(as_float_type):
break;
case(as_fixed_type):
break;
case(as_digits):
case(as_delta):
adasem(N_AST1(node));
adasem(N_AST2(node));
break;
/* array_type_definition -> ['array_type' index_list subtype_indication]*/
case(as_array_type):
array_typedef(node);
break;
/* subtype_definition -> ['box' name]*/
case(as_box):
adasem(N_AST1(node));
break;
/* discrete_range -> [as_subtype opt_name range_constraint]
* general_component_association ->[as_subtype opt_name range-constraint]
*/
case(as_subtype):
/*[opt_name, range_constraint] := N_AST(node);*/
n1 = N_AST1(node);
n2 = N_AST2(node);
if (n1 != OPT_NODE) {
adasem(n1);
find_old(n1);
}
if (n2 == OPT_NODE) { /* possible, if syntax error */
N_KIND(node) = as_name;
}
else adasem(n2);
break;
/* record_decl -> [as_record component_list]*/
case(as_record):
adasem(N_AST1(node));
break;
/* component_list -> [ 'component_list' component_decl_list variant]*/
case(as_component_list):
/*[component_decl_list, variant] := N_AST(node);*/
sem_list(N_AST1(node));
adasem(N_AST2(node));
break;
/* component_declaration -> ['field' identifier_list subtype_indic
* opt_expression]
*/
case(as_field):
comp_decl(node);
break;
/* discr_specification -> ['discr_spec' identifier_list name opt_expr]*/
case(as_discr_spec):
/*[id_list_node, name, opt_expr] := N_AST(node);*/
adasem(N_AST2(node));
/* adasem(N_AST3(node)); */
break;
/* variant_part -> ['variant_decl' simple_name variant_list]*/
case(as_variant_decl):
variant_decl(node);
break;
/* component_association -> ['choice_list' choice_list expression]*/
case(as_choice_list):
/*[choice_list, expression] := N_AST(node);*/
sem_list(N_AST1(node));
adasem(N_AST2(node));
break;
case(as_simple_choice):
adasem(N_AST1(node));
break;
case(as_range_choice):
adasem(N_AST1(node));
break;
case(as_others_choice):
break;
case(as_choice_unresolved):
adasem(N_AST1(node));
break;
case(as_access_type):
n1 = N_AST1(node);
adasem(n1);
n2 = N_AST1(n1);
n3 = N_AST2(n1);
if (n3 == OPT_NODE ) {
/*Special case: type mark may be an incomplete type.*/
N_UNQ(n1) = find_type(n2);
}
else { /* elaborate subtype indication*/
N_UNQ(n1) = promote_subtype(make_subtype(n1));
}
break;
/* incomplete_type_decl -> ['incomplete_decl' identifier discriminant]*/
case(as_incomplete_decl):
incomplete_decl(node);
break;
/* declarations -> ['declarations' declaration_list]*/
case(as_declarations):
declarative_part(node);
break;
/* Chapter 4. Names and expressions */
/* name -> ['character_literal' character]
* Character literals also appear as enumeration literals, and as
* selectors.
*/
case(as_character_literal):
break;
/* name -> ['simple_name' identifier]*/
case(as_simple_name):
break;
/* name -> ['call?' name general_aggregate]*/
case(as_call_unresolved):
n1 = N_AST1(node);
n2 = N_AST2(node);
if (N_KIND(n1) == as_string) {
/* Operator designator: reduce to lower case.*/
/*N_VAL(n1) = LOWER_CASE_OF(N_VAL(n1));*/
id = N_VAL(n1);
while(*id) {
if (isupper(*id)) *id = tolower(*id);
id++;
}
}
adasem(n1);
FORTUP(n1 = (Node), N_LIST(n2), ft1);
adasem(n1);
ENDFORTUP(ft1);
break;
/* name -> ['operator' operator_symbol]*/
case(as_operator):
N_KIND(node) = as_simple_name;
break;
case(as_string):
N_KIND(node) = as_simple_name;
break;
/* name -> ['.' name selector]*/
case(as_selector):
adasem(N_AST1(node));
break;
case(as_all):
adasem(N_AST1(node));
break;
case(as_attribute):
adasem(N_AST2(node));
adasem(N_AST3(node));
break;
/* aggregate -> [as_aggregate expression_list]*/
case(as_aggregate):
sem_list(node);
break;
/* parenthesised_expression -> ['()', expression]*/
case(as_parenthesis):
adasem(N_AST1(node) );
break;
/* expression -> [operator_designator <expression..>]*/
case(as_op):
case(as_un_op):
/*[op_node, arg_list] := N_AST(node);*/
n1 = N_AST1(node);
op_id = N_VAL(n1);
/* KLUDGE until parser fixed. */
if (streq(op_id, "NOT")) N_VAL(n1) = strjoin("not", "");
else if (streq(op_id, "AND")) N_VAL(n1) = strjoin("and", "");
else if (streq(op_id, "XOR")) N_VAL(n1) = strjoin("xor", "");
else if (streq(op_id, "REM")) N_VAL(n1) = strjoin("rem", "");
else if (streq(op_id, "MOD")) N_VAL(n1) = strjoin("mod", "");
else if (streq(op_id, "OR")) N_VAL(n1) = strjoin("or", "");
n2 = N_AST2(node);
find_old(n1);
FORTUP(n3 = (Node), N_LIST(n2), ft1);
adasem(n3);
/*
* the call to check_range_attribute is useless, since
* adasem converts a